home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / ACCDEMO.M next >
Encoding:
Text File  |  1991-04-09  |  2.9 KB  |  105 lines
  1. MODULE AccDemo;
  2.  
  3.     (*
  4.      *             Demo program for a 'safe' accessory
  5.      *
  6.      *           written by Andreas Pauletti 29.05.1988
  7.      *                   with MEGAMAX MODULA-2
  8.      *
  9.      *
  10.      * Thomas Tempelmann: Durch Abfrage mit der Funktion 'Accessory' kann
  11.      * nun auch das Programm alternativ als Programm mit der Endung PRG
  12.      * (statt ACC) direkt vom Desktop gestartet werden.
  13.      *)
  14.  
  15. (*$E MAC     Endung für Linker: Datei mit Endung ACC erzeugen *)
  16. (*$R-,S-     Keine Bereichs-, Überlauf- und Stackprüfung *)
  17.  
  18. FROM SYSTEM IMPORT ADR;
  19.  
  20. IMPORT GEMEnv;
  21. FROM AESForms IMPORT FormAlert;
  22. FROM AESEvents IMPORT MessageEvent, MessageBuffer, accOpen;
  23. FROM AESMenus IMPORT RegisterAcc;
  24. FROM PrgCtrl IMPORT Accessory;
  25. IMPORT Strings, HdlError, EasyExceptions;
  26.  
  27. VAR
  28.   devHdl: GEMEnv.DeviceHandle;
  29.   gemHdl: GEMEnv.GemHandle;
  30.   menuID: CARDINAL;
  31.   menuEntry: ARRAY[0..19] OF CHAR; (* must be global!! *)
  32.   msg: MessageBuffer;
  33.   done: BOOLEAN;
  34.   retButton: CARDINAL;
  35.  
  36. PROCEDURE DoTheWork;
  37.  
  38.   CONST
  39.     Alert1 = '[1][This is the first alert box| |    ERROR will raise|    an exception as|    a demonstration][OTHER|ERROR|QUIT]';
  40.     Alert2 = '[1][This is the second alert box][OTHER|QUIT]';
  41.  
  42.   VAR d,c: CARDINAL;
  43.  
  44.   BEGIN
  45.     LOOP
  46.       FormAlert(1, Alert1, retButton);
  47.       IF retButton = 3 THEN
  48.         EXIT
  49.       ELSIF retButton = 2 THEN
  50.         (* generate an error to demonstrate the use of 'EasyException.Call' *)
  51.         c:= 0;
  52.         c:= d DIV c; (* causes a 'division by zero' exception *)
  53.       END;
  54.       FormAlert (1, Alert2, retButton);
  55.       IF retButton = 2 THEN
  56.         EXIT
  57.       END
  58.     END
  59.   END DoTheWork;
  60.  
  61.  
  62. PROCEDURE DoItSafely;
  63.  
  64.   VAR excResult: EasyExceptions.Exception;
  65.       msg: ARRAY [0..99] OF CHAR;
  66.       ok: BOOLEAN;
  67.  
  68.   BEGIN
  69.     EasyExceptions.Call (DoTheWork, excResult);
  70.     IF excResult # EasyExceptions.NormalReturn () THEN
  71.       HdlError.GetErrorMsg (EasyExceptions.StdErrNo (excResult), msg);
  72.       Strings.Insert ("[0][There was an error:|", 0, msg, ok);
  73.       Strings.Append ("|But the system did not crash][Great!]", msg, ok);
  74.       FormAlert(1, msg, retButton)
  75.     END
  76.   END DoItSafely;
  77.  
  78. BEGIN
  79.   GEMEnv.InitGem (GEMEnv.RC, devHdl, done);
  80.   IF done THEN
  81.     gemHdl:= GEMEnv.CurrGemHandle ();
  82.     IF NOT Accessory () THEN
  83.       (*
  84.        * Started as normal program -> activate immediately
  85.        *)
  86.       DoItSafely
  87.     ELSE
  88.       (*
  89.        * Started as accessory -> wait for activation via gem-menu
  90.        *)
  91.       menuEntry:= '  Accessory Demo';
  92.       RegisterAcc(ADR(menuEntry), menuID , done);
  93.       IF NOT done THEN
  94.         FormAlert(1, "[0][Can't install AccDemo][OK]", retButton)
  95.       END;
  96.       LOOP
  97.         MessageEvent(msg);
  98.         IF (msg.msgType = accOpen) THEN
  99.           DoItSafely
  100.         END
  101.       END               (* Endless loop! Accessories never terminate! *)
  102.     END
  103.   END
  104. END AccDemo.
  105.